home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / detect2r / mhdock.bas < prev    next >
BASIC Source File  |  1999-08-31  |  14KB  |  303 lines
  1. Attribute VB_Name = "modMHDock"
  2. Option Explicit
  3.  
  4. Public Type seVarsType
  5.     origWndProc As Long ' Parent form's original WndProc address
  6.     lParenthWnd As Long ' Parent form's hWnd
  7.     lTophWnd As Long    ' MDIForm parent form hWnd
  8.     lTrayhWnd As Long   ' System tray hWnd
  9.     lseHwnd As Long     ' MHDock control hWnd
  10.     lxDock As Long      ' xDock property
  11.     lyDock As Long      ' yDock property
  12.     bDockEnabled As Long
  13. End Type
  14.  
  15. Public Type RECT
  16.     Left As Long
  17.     Top As Long
  18.     Right As Long
  19.     Bottom As Long
  20. End Type
  21.  
  22. Public Type POINTAPI
  23.     X As Long
  24.     Y As Long
  25. End Type
  26.  
  27. Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  28. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  29. Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  30. Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  31. Public Declare Function GetDesktopWindow Lib "user32" () As Long
  32. Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  33. Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  34. Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  35. Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  36. Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  37. Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  38. Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  39. Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
  40.     
  41. Public Const GWL_WNDPROC = (-4)
  42. Public Const WM_DESTROY = &H2
  43. Public Const WM_MOVE = &H3
  44. Public Const WM_MOVING = &H216
  45. Public Const WM_MOUSEMOVE = &H200
  46. Public Const WM_ENTERSIZEMOVE = &H231
  47. Public Const WM_EXITSIZEMOVE = &H232
  48. Public Const SPI_GETBORDER = 5
  49.  
  50. Public Const GMEM_FIXED = &H0
  51. Public Const GMEM_ZEROINIT = &H40
  52. Public Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
  53.  
  54. Dim seVars As seVarsType, hMem As Long, lLasthWnd As Long
  55.  
  56. Public Function AppWndProc(ByVal hwnd As Long, ByVal Msg As Long, _
  57.     ByVal wParam As Long, ByVal lParam As Long) As Long
  58.     Static pSave As POINTAPI, bSnappedX As Boolean, _
  59.         bSnappedY As Boolean
  60.     Static bLeft As Boolean, bTop As Boolean, bRight As Boolean, _
  61.         bBottom As Boolean
  62.     Static rOrig As RECT, bOrig As Boolean, rParent As RECT, _
  63.         rLatest As RECT
  64.     Static lMinX As Long, lMaxX As Long, lMinY As Long, _
  65.         lMaxY As Long
  66.     Static lxDock As Long, lyDock As Long
  67.     
  68.     If hwnd <> lLasthWnd Then
  69.         ' Get the seVars structure copy from the locked memory
  70.         hMem = Val(GetSetting("MHDock", "hMem", CStr(hwnd)))
  71.         CopyMemory seVars, ByVal hMem, LenB(seVars)
  72.         lLasthWnd = hwnd
  73.     End If
  74.     
  75.     Dim bDockNow As Boolean, P As POINTAPI, rTemp As RECT
  76.     Dim lBorder As Long, lEvent As Long
  77.     Select Case Msg
  78.         Case WM_ENTERSIZEMOVE, WM_EXITSIZEMOVE
  79.             Dim pErase As POINTAPI
  80.             Dim rErase As RECT
  81.             pSave = pErase
  82.             bSnappedX = False
  83.             bSnappedY = False
  84.             bLeft = False
  85.             bTop = False
  86.             bRight = False
  87.             bBottom = False
  88.             rOrig = rErase
  89.             bOrig = False
  90.             rParent = rErase
  91.             rLatest = rErase
  92.             lMinX = 0
  93.             lMaxX = 0
  94.             lMinY = 0
  95.             lMaxY = 0
  96.             lxDock = 0
  97.             lyDock = 0
  98.         Case WM_MOVING
  99.             If seVars.bDockEnabled Then
  100.                 ' The user is moving the Form. The moving rectangle
  101.                 ' is passed as a pointer in lParam
  102.                 CopyMemory rLatest, ByVal lParam, Len(rLatest)
  103.                 If Not bOrig Then
  104.                     ' First time in - get the parent rectangle to
  105.                     ' determine docking position
  106.                     bOrig = True: LSet rOrig = rLatest
  107.                     GetWindowRect seVars.lTophWnd, rParent
  108.                     lMinX = rParent.Left
  109.                     lMaxX = rParent.Right
  110.                     lMinY = rParent.Top
  111.                     lMaxY = rParent.Bottom
  112.                     lxDock = seVars.lxDock \ Screen.TwipsPerPixelX
  113.                     lyDock = seVars.lyDock \ Screen.TwipsPerPixelY
  114.                     If seVars.lTrayhWnd Then
  115.                         ' This form is on the screen - get the tray
  116.                         ' position and offset the Dock positions
  117.                         GetWindowRect seVars.lTrayhWnd, rTemp
  118.                         If rTemp.Left > 0 Then
  119.                             ' Bar is on the right
  120.                             lMaxX = lMaxX - (rTemp.Right - _
  121.                                 rTemp.Left) + 2
  122.                         ElseIf rTemp.Top > 0 Then
  123.                             ' Bar is on the bottom
  124.                             lMaxY = lMaxY - (rTemp.Bottom - _
  125.                                 rTemp.Top) + 2
  126.                         ElseIf rTemp.Right > lMaxX \ 2 Then
  127.                             ' Bar is on the top
  128.                             lMinY = rTemp.Bottom
  129.                         Else
  130.                             ' Bar is on the left
  131.                             lMinX = rTemp.Right
  132.                         End If
  133.                     Else
  134.                         ' This is a child window, so don't try to
  135.                         ' dock beyond the parent's borders
  136.                         SystemParametersInfo SPI_GETBORDER, 0, lBorder, 0
  137.                         lBorder = lBorder * 2
  138.                         lMinX = lMinX + lBorder
  139.                         lMaxX = lMaxX - lBorder
  140.                         lMinY = lMinY + lBorder
  141.                         lMaxY = lMaxY - lBorder
  142.                     End If
  143.                 End If
  144.                 If rLatest.Left <= lMinX + lxDock Then
  145.                     ' Dock to the left
  146.                     bDockNow = True
  147.                     rLatest.Left = lMinX
  148.                     rLatest.Right = rLatest.Left + (rOrig.Right - _
  149.                         rOrig.Left)
  150.                     bLeft = True
  151.                 ElseIf rLatest.Right >= lMaxX - lxDock Then
  152.                     ' Dock to the right
  153.                     bDockNow = True
  154.                     rLatest.Right = lMaxX
  155.                     rLatest.Left = rLatest.Right - (rOrig.Right - _
  156.                         rOrig.Left)
  157.                     bRight = True
  158.                 End If
  159.                 If rLatest.Top <= lMinY + lyDock Then
  160.                     ' Dock to the top
  161.                     bDockNow = True
  162.                     rLatest.Top = lMinY
  163.                     rLatest.Bottom = rLatest.Top + (rOrig.Bottom - _
  164.                         rOrig.Top)
  165.                     bTop = True
  166.                 ElseIf rLatest.Bottom >= lMaxY - lyDock Then
  167.                     ' Dock to the bottom
  168.                     bDockNow = True
  169.                     rLatest.Bottom = lMaxY
  170.                     rLatest.Top = rLatest.Bottom - (rOrig.Bottom - _
  171.                         rOrig.Top)
  172.                     bBottom = True
  173.                 End If
  174.                 If bDockNow Or bSnappedX Or bSnappedY Then
  175.                     ' User needs to Dock or is currently Docked
  176.                     ' (and we need to check for unDock conditions)
  177.                     GetCursorPos P
  178.                     If bDockNow And Not bSnappedX And (bLeft Or _
  179.                         bRight) Then
  180.                         ' First time Docking Left or Right
  181.